!======================================================================
!
!    HEEDS (Higher Education Enrollment Decision Support) - A program
!      to create enrollment scenarios for 'next term' in a university
!    Copyright (C) 2012, 2013 Ricolindo L Carino
!
!    This file is part of the HEEDS program.
!
!    HEEDS is free software: you can redistribute it and/or modify
!    it under the terms of the GNU General Public License as published by
!    the Free Software Foundation, either version 3 of the License, or
!    (at your option) any later version.
!
!    HEEDS is distributed in the hope that it will be useful,
!    but WITHOUT ANY WARRANTY; without even the implied warranty of
!    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!    GNU General Public License for more details.
!
!    You should have received a copy of the GNU General Public License
!    along with this program (see the file COPYING.TXT). If not, see
!    <http://www.gnu.org/licenses/>.
!
!    Send inquiries about HEEDS to:
!      Ricolindo L Carino
!      E-mail: Ricolindo.Carino@AcademicForecasts.com
!      Address: 600 Cruise St., Starkville, MS 39759, U.S.A.
!
!======================================================================


module WAIVERS

    use SECTIONS
    USE STUDENTS

    implicit none

    type :: TYPE_WAIVER
        integer :: lenSubject
        integer, dimension(MAX_SUBJECTS_PER_TERM) :: Subject, Section
    end type TYPE_WAIVER

    type (TYPE_WAIVER), dimension(0:MAX_ALL_STUDENTS) :: WaiverCOI
    integer :: NumWaiverRecords
    logical :: isDirtyWaiverCOI = .false.

    ! private tokens
    character (len=MAX_LEN_FILE_PATH), private :: fileName
    character (len=MAX_LEN_XML_LINE), private :: line
    integer, private :: unitNo=2, eof, ndels, pos(30)

contains


    subroutine initialize_waiver(W)
        type (TYPE_WAIVER) :: W
        W = TYPE_WAIVER (0, 0, 0)
        return
    end subroutine initialize_waiver


    subroutine xml_write_waivers(path, Section)
        character (len=*), intent (in) :: path ! YEAR/TERM/WAIVER-COI
        type (TYPE_SECTION), intent(in), dimension (0:) :: Section

        integer :: std, sect, i

        ! training only?
        if (noWrites) return

        ! make backup & open new file
        fileName = trim(dirXML)//trim(path)//'WAIVER-COI.XML'
        call move_to_backup(fileName)
        call xml_open_file(unitNo, XML_ROOT_WAIVERS, fileName, eof)
        write(unitNo,AFORMAT) &
        '    <comment>', &
        '        Generated by '//PROGNAME//VERSION//' on '//currentDate(1:4)// &
                    FSLASH//currentDate(5:6)//FSLASH//currentDate(7:8), &
        '        StdNo    : Student number', &
        '        Section   : Enlisted section', &
        '        Subject    : Allowed subject (COI/waive prerequisite)', &
        '    </comment>'

        do std=1,NumStudents
            if (WaiverCOI(std)%lenSubject==0) cycle ! skip student with no record
            call xml_write_character(unitNo, indent0, 'WaiverCOI')
            call xml_write_character(unitNo, indent1, 'StdNo', Student(std)%StdNo)
            do i=1,WaiverCOI(std)%lenSubject
                sect = WaiverCOI(std)%Section(i)
                if (sect>0) then
                    call xml_write_character(unitNo, indent1, 'Section', Section(sect)%ClassId)
                else
                    call xml_write_character(unitNo, indent1, 'Subject', Subject(WaiverCOI(std)%Subject(i))%Name)
                end if
            end do
            call xml_write_character(unitNo, indent0, '/WaiverCOI')
        end do

        ! close file
        call xml_close_file(unitNo, XML_ROOT_WAIVERS)

        return
    end subroutine xml_write_waivers


    subroutine xml_read_waivers(path, NumSections, Section, numEntries, errNo, openQuietly)

        character(len=*), intent(in) :: path
        integer, intent (in) :: NumSections
        type (TYPE_SECTION), intent(in), dimension (0:) :: Section
        integer, intent (out) :: numEntries, errNo
        logical, optional, intent(in) :: openQuietly

        character(len=MAX_LEN_XML_LINE) :: value
        character(len=MAX_LEN_XML_TAG) :: tag
        type(TYPE_WAIVER) :: wrk
        character (len=MAX_LEN_SUBJECT_CODE) :: tSubject
        character (len=MAX_LEN_CLASS_ID) :: tClass
        character (len=MAX_LEN_STUDENT_CODE) :: tStdNo
        integer :: cdx, sdx, std
        logical :: quiet

        if (present(openQuietly)) then
            quiet = openQuietly
        else
            quiet = .false.
        end if

        numEntries = 0
        ! open file, return on any error
        fileName = trim(dirXML)//trim(path)//'WAIVER-COI.XML'
        call xml_open_file(unitNo, XML_ROOT_WAIVERS, fileName, errNo, forReading, quiet)
        if (errNo/=0) return

        ! examine the file line by line
        do
            read(unitNo, AFORMAT, iostat=eof) line
            if (eof<0) exit

            ! get tag and value if any; exit on any error
            call xml_parse_line(line, tag, value, eof)
            if (eof/=0) exit

            select case (trim(tag))

                case ('WaiverCOI') ! initialize temporary data
                    call initialize_waiver (wrk)

                case ('StdNo')
                    tStdNo = adjustl(value)
                    std = index_to_student(tStdNo)

                case ('Section')
                    tClass = adjustl(value)
                    sdx = index_to_section(tClass, NumSections, Section)
                    if (sdx==0) then ! invalid class; attempt to extract subject
                        sdx = len_trim(tClass)
                        do while (sdx>1 .and. tClass(sdx:sdx)/=SPACE)
                            sdx = sdx-1
                        end do
                        tSubject = tClass(:sdx)
                        cdx = index_to_subject(tSubject)
                        if (cdx<=0) then ! subject code not found
                            call file_log_message ('No such class; ignored - '//tClass)
                            cycle
                        end if
                        ! add as subject
                        call check_array_bound (wrk%lenSubject, MAX_SUBJECTS_PER_TERM, 'MAX_SUBJECTS_PER_TERM')
                        wrk%lenSubject = wrk%lenSubject + 1
                        wrk%Subject(wrk%lenSubject) = cdx
                    else ! add as section
                        call check_array_bound (wrk%lenSubject, MAX_SUBJECTS_PER_TERM, 'MAX_SUBJECTS_PER_TERM')
                        wrk%lenSubject = wrk%lenSubject + 1
                        wrk%Section(wrk%lenSubject) = sdx
                        wrk%Subject(wrk%lenSubject) = Section(sdx)%SubjectIdx
                    end if

                case ('Subject')
                    tSubject = adjustl(value)
                    cdx = index_to_subject(tSubject)
                    if (cdx<=0) then ! subject code not found
                        call file_log_message ('No such subject; ignored - '//tSubject)
                        cycle
                    end if
                    ! add as allowed subject
                    call check_array_bound (wrk%lenSubject, MAX_SUBJECTS_PER_TERM, 'MAX_SUBJECTS_PER_TERM')
                    wrk%lenSubject = wrk%lenSubject + 1
                    wrk%Subject(wrk%lenSubject) = cdx

                case ('/WaiverCOI')
                    if (std/=0) then
                        WaiverCOI(std) = wrk
                        numEntries = numEntries+1
                    else
                        call file_log_message ('No such student; ignored - '//tStdNo)
                    end if

                case default ! do nothing

            end select

        end do

        call xml_close_file(unitNo)
        call file_log_message (itoa(numEntries)//' in '//fileName)

        return
    end subroutine xml_read_waivers


    subroutine read_waivers(path, NumSections, Section, Offering, numEntries, errNo)

        character(len=*), intent(in) :: path ! YEAR/TERM
        integer, intent (in) :: NumSections
        type (TYPE_SECTION), intent(in out), dimension (0:) :: Section
        type (TYPE_OFFERED_SUBJECTS), dimension (MAX_ALL_DUMMY_SUBJECTS:MAX_ALL_SUBJECTS) :: Offering
        integer, intent (in out) :: numEntries
        integer, intent (out) :: errNo

        integer :: ierr
        logical :: noXML

        errNo = 0 ! OK if there's no waiver record

        ! try the monolithic XML file
        call xml_read_waivers(path, NumSections, Section, numEntries, ierr)
        noXML = numEntries==0
        if (numEntries==0) then ! no XML entries
            call custom_read_waivers (trim(dirRAW)//trim(path)//'WAIVER-COI', &
                NumSections, Section, Offering, WaiverCOI, numEntries, ierr)
        end if

        if (noXML .and. numEntries>0) then ! write the XML waiver file?
            call xml_write_waivers(path, Section)
        end if

        return
    end subroutine read_waivers


    subroutine custom_read_waivers (filePath, NumSections, Section, Offering, cList, numEntries, ier)
        character(len=*), intent(in) :: filePath
        integer, intent (in) :: NumSections
        type (TYPE_SECTION), intent(in), dimension (0:) :: Section
        type (TYPE_OFFERED_SUBJECTS), dimension (MAX_ALL_DUMMY_SUBJECTS:MAX_ALL_SUBJECTS) :: Offering
        type (TYPE_WAIVER), intent(in out) :: cList(0:)
        integer, intent (out) :: numEntries, ier
        integer :: cdx, i, j, sdx, std, tcdx, tsdx
        integer :: unitf5=50
        character (len=MAX_LEN_STUDENT_CODE) :: OldStd, NewStd
        character (len=MAX_LEN_SUBJECT_CODE) :: tSubject, token
        character (len=MAX_LEN_CLASS_ID) :: tSection
        logical :: skip

        numEntries = 0
        open(unit=unitf5, file=filePath, form='formatted', status='old', iostat=ier)
        if (ier/=0) return

        std = 0
        OldStd = '          '
        call file_log_message ('Retrieving '//filePath)
        loop_waiver: &
        do
            read (unitf5, AFORMAT, iostat = eof) line
            if (eof<0) exit loop_waiver
            if (line(1:1)=='#' .or. line(1:3)=='   ') cycle loop_waiver
            call index_to_delimiters(COMMA, line, ndels, pos)
            if (ndels<6) then
                ier = 150
                call file_log_message (trim(line)//' - there must be at least 6 tokens')
                return
            end if

            NewStd = line(pos(1)+1:pos(2)-1)
            if (NewStd/=OldStd) then
                std = index_to_student(NewStd)
                if (std==0) then
                    call file_log_message (trim(line)//' - not an active student?')
                    skip = .true.
                    OldStd = NewStd
                    cycle loop_waiver
                else if (cList(std)%lenSubject<0) then ! already enlisted in a previous run
                    skip = .true.
                    OldStd = NewStd
                    cycle loop_waiver
                end if
                OldStd = NewStd
                skip = .false.
            else if (skip) then
                cycle loop_waiver
            end if

            !StdNo,Year,Term,Subject,Section,Units,Grade
            !1    2    3    4      5       6     7     8

            ! If Section is empty, assume subject prerequisite is waived, or COI is given
            ! If Section is specified, force-enlist student (priority Group 0)

            ! retrieve index of subject
            tSubject = line(pos(4)+1:pos(5)-1)
            cdx = index_to_subject(tSubject)
            if (cdx==0) then
                ier = 152
                call file_log_message (trim(text_student_info(std))//' - '//trim(tSubject)//' - subject is not in catalog.')
                cycle loop_waiver ! return
            end if
            ! check if offered
            if (Offering(cdx)%NSections==0) then
                call file_log_message (NewStd//SPACE//tSubject//'- waived prereq or w/ COI, but no sections open!')
                cycle loop_waiver
            end if
            ! check for duplicates
            i = index(tSubject, DASH)
            if (i>0) tSubject(i:) = SPACE
            do i=1,cList(std)%lenSubject
                token = Subject(cList(std)%Subject(i))%Name
                j = index(token, DASH)
                if (j>0) token(j:) = SPACE
                if (tSubject==token) then ! move to front
                    !         write(*,*) tSubject//' - already predicted; moving to front...'
                    if (i>1) then
                        tcdx = cList(std)%Subject(i)
                        tsdx = cList(std)%Section(i)
                        do j=i-1,1,-1
                            cList(std)%Subject(j+1) = cList(std)%Subject(j)
                            cList(std)%Section(j+1) = cList(std)%Section(j)
                        end do
                        cList(std)%Subject(1) = tcdx
                        cList(std)%Section(1) = tsdx
                        cycle loop_waiver
                    end if
                end if
            end do

            tSection = adjustl(line(pos(5)+1:pos(6)-1))
            if (tSection=='') then ! not accommodated
                sdx = 0
              !write(*,*)  'Waiver/COI: '//tSubject//trim(text_student_info(std))
            else
                tSection = trim(Subject(cdx)%Name)//SPACE//tSection
                !         tSection = trim(tSubject)//SPACE//tSection
                sdx = index_to_section(tSection, NumSections, Section)
                if (sdx==0) then
                    call file_log_message (trim(text_student_info(std))//' - '//tSubject//' - no such class; ignored.')
                    cycle loop_waiver
                else
                  !write(*,*)  'Pre-Enlist: '//tSection//trim(text_student_info(std))
                end if
            end if

            ! move to front
            if (cList(std)%lenSubject>=MAX_SUBJECTS_PER_TERM) cList(std)%lenSubject = MAX_SUBJECTS_PER_TERM-1

            do j=cList(std)%lenSubject,1,-1
                cList(std)%Subject(j+1) = cList(std)%Subject(j)
                cList(std)%Section(j+1) = cList(std)%Section(j)
            end do
            cList(std)%Subject(1) = cdx
            cList(std)%Section(1) = sdx
            cList(std)%lenSubject = cList(std)%lenSubject + 1

            numEntries = numEntries + 1
        end do loop_waiver
        close(unitf5)
        return
    end subroutine custom_read_waivers


end module WAIVERS
